home *** CD-ROM | disk | FTP | other *** search
- /* $VER: bbsKillUser.rexx 8.3 (4.12.94)
- copyright © 1990-94 Richard Lee Stockton
- BBBBS Delete User
- FREELY DISTRIBUTABLE
- */
-
- SIGNAL ON BREAK_C
- SIGNAL ON FAILURE
- SIGNAL ON SYNTAX
-
- lineup='1B'x'M'
- CR=''
- frombb=0
- IF ADDRESS()='BAUD' THEN
- DO
- frombb=1
- CR='0D'x
- END
-
- ARG in_name .
- name=''
- IF in_name~='' THEN name=in_name
-
- bbspath=GETCLIP('BBS_path')
- IF bbspath='' THEN
- DO
- SAY 'No BBS_path!'
- EXIT 20
- END
-
- killcount=0
- DO loop=1
- IF name='' THEN
- DO
- OPTIONS PROMPT 'RETURN=QUIT Username to Kill: '
- PULL name
- END
- IF STRIP(name)='' THEN LEAVE loop
- name=SPACE(STRIP(UPPER(name)),1,'_')
- IF readlines(bbspath'Users/'name 1) THEN
- DO
- SAY 'User' name 'not found.'CR
- name=''
- ITERATE loop
- END
- IF level<=lynes.20 THEN
- DO
- SAY '*** Tsk! Tsk! Your level is not greater than' name'.'CR
- CALL send2log('Tried to kill:' name)
- name=''
- ITERATE loop
- END
- IF getinput(1 1 'Really kill' name'? (nY) > ')='N' THEN
- DO
- name=''
- ITERATE loop
- END
- f0='Morgue/'name'.lha'
- f1='Users/'name
- f2='Friends/'name
- f3='Profiles/'name
- f4='Email/'name
- f5='EmailFiles/'name
- IF EXISTS(bbspath'Morgue') THEN
- IF getinput(1 1 'Archive' name 'to Morgue? (Ny) > ')='Y' THEN
- ADDRESS COMMAND 'CD' bbspath'0A'x||'lha -2ar a' f0 f1 f2 f3 f4 f5
- CALL DELETE(bbspath||f1)
- CALL DELETE(bbspath||f2)
- CALL DELETE(bbspath||f3)
- IF EXISTS(bbspath||f4) THEN ADDRESS COMMAND 'C:DELETE >*' bbspath||f4 'ALL'
- IF EXISTS(bbspath||f5) THEN ADDRESS COMMAND 'C:DELETE >*' bbspath||f5 'ALL'
- SAY CR
- SAY CR'User file, Email & EmailFiles for' name 'have been deleted.'CR
- IF EXISTS(bbspath||f0) THEN SAY f0 'is' WORD(STATEF(bbspath||f0),2) 'bytes.'
- CALL send2log('Killed' name)
- killcount=killcount+1
- name=''
- IF in_name~='' THEN LEAVE loop
- END
- IF killcount>0 THEN
- DO
- CALL DELETE(bbspath'Lists/USERS')
- IF SHOW('P','BBBBS') THEN CALL SETCLIP('BBS_localusers',1)
- IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainusers',1)
- END
- EXIT
-
-
- readlines:
- CALL CLOSE(f)
- PARSE ARG tempname readstart .
- IF OPEN(f,tempname,'R')=0 THEN RETURN 1
- IF readstart<2 THEN lynes.=''
- DO ri=readstart
- line=READLN(f)
- IF EOF(f) THEN BREAK
- lynes.ri=line
- END
- lynes.0=ri-1
- CALL CLOSE(f)
- DO ri=lynes.0 TO 0 BY -1 WHILE LENGTH(lynes.ri)=0 | LEFT(UPPER(lynes.ri),1)='/'
- END
- lynes.0=ri
- RETURN 0
-
-
- send2log:
- PARSE ARG sendline
- IF ~frombb THEN RETURN
- logfile=bbspath'Logs/log.'DATE('S')
- fl='W'
- IF EXISTS(logfile) THEN fl='A'
- IF ~OPEN('log',logfile,fl) THEN
- DO
- CALL DELAY(99)
- IF ~OPEN('log',logfile,fl) THEN
- DO
- SAY 'failed to open log file'CR
- RETURN
- END
- END
- CALL WRITELN('log','bbsKillUser:' sendline)
- CALL CLOSE('log')
- RETURN
-
-
- getinput:
- PARSE ARG upflag' 'oneflag' 'pline
- OPTIONS PROMPT pline
- PARSE PULL inarg
- inarg=STRIP(inarg)
- IF upflag THEN inarg=UPPER(inarg)
- IF oneflag THEN inarg=LEFT(inarg,1)
- inarg=cleanstring(inarg)
- RETURN inarg
-
-
- cleanstring:
- PARSE ARG cstr
- bot=XRANGE(,'1F'x)
- top=XRANGE('7F'x)
- cstr=COMPRESS(cstr,bot||top)
- IF nflag=0 THEN cstr=STRIP(cstr)
- RETURN cstr
-
-
- BREAK_C:
- EXIT
-
-
- FAILURE:
- SYNTAX:
- lin.1=''ERRORTEXT(RC)''
- lin.2=SIGL-1 SOURCELINE(SIGL-1)
- lin.3=SIGL ''SOURCELINE(SIGL)''
- lin.4=SIGL+1 SOURCELINE(SIGL+1)
- DO er=1 TO 4
- IF level>sysoplevel | ~frombb THEN SAY 'bbsKillUser:' lin.er||CR
- CALL send2log(lin.er)
- END
- EXIT
-
- /* bbsKillUser.rexx */
-